home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvdmx.exe / TVDMX.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-16  |  60KB  |  2,362 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    tvDMX     --data editing project (ver 1.5)    }
  5. {                            }
  6. {    Copyright (c) 1992  Randolph Beck        }
  7. {                P.O. Box  56-0487        }
  8. {                Orlando, FL 32856        }
  9. {                CIS:  72361,753        }
  10. {                            }
  11. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  12.  
  13. Unit tvDMX;
  14.  
  15. {$B-,D-,O+,R-,X+,V- }
  16.  
  17. interface
  18.  
  19. uses  Objects, Drivers, Views, App, RSet, DmxGizma;
  20.  
  21. type
  22.     PDmxLink     = ^TDmxLink;
  23.     PDmxLabels     = ^TDmxLabels;
  24.     PDmxScroller = ^TDmxScroller;
  25.     PDmxRecInd     = ^TDmxRecInd;
  26.     PDmxEditor     = ^TDmxEditor;
  27.  
  28.  
  29.     TDmxLink    =  OBJECT (TView)
  30.     Link  : PDmxScroller;
  31.       constructor Init (Bounds : TRect);
  32.       constructor Load (var S : TStream);
  33.       function  GetPalette : PPalette;  VIRTUAL;
  34.       procedure Store (var S : TStream);
  35.       procedure Insert (AOwner : PGroup);
  36.     end;
  37.  
  38.  
  39.     TDmxLabels    =  OBJECT (TDmxLink)
  40.     Len   : integer;
  41.     Data  : PCharArray;
  42.       constructor Init (DataStr : pstring; var Bounds : TRect);
  43.       constructor InitInsert (AOwner : PGroup;  DataStr : pstring);
  44.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  45.       procedure Draw;  VIRTUAL;
  46.       procedure DrawRuler (Upper, AtLimit : boolean);
  47.       constructor Load (var S : TStream);
  48.       procedure Store (var S : TStream);
  49.     end;
  50.  
  51.  
  52.     TDmxScroller =  OBJECT (TScroller)
  53.     Labels        : PDmxLink;
  54.     WorkingData    : pointer;
  55.     DataBlockSize    : longint;
  56.     CurrentRecord    : integer;
  57.     CurrentField    : pDMXfieldrec;
  58.     DMXfield1    : pDMXfieldrec;
  59.     LeftField    : pDMXfieldrec;
  60.     TotalFields    : integer;
  61.     RecordSize    : integer;
  62.     Locked        : boolean;
  63.     InitValid    : boolean;
  64.       constructor Init (ATemplate  : string; var AData; BSize : longint;
  65.         var Bounds : TRect;  ALabels : PView;  AHScrollBar,AVScrollBar : PScrollBar);
  66.       procedure   InitStruct (var ATemplate );  VIRTUAL;
  67.       procedure   InitData (var AData );  VIRTUAL;
  68.       destructor  Done;  VIRTUAL;
  69.       constructor Load (var S : TStream);
  70.       procedure Store (var S : TStream);
  71.       procedure LoadData (var S : TStream);  VIRTUAL;
  72.       procedure LoadStruct (var S : TStream);  VIRTUAL;
  73.       procedure StoreData (var S : TStream);  VIRTUAL;
  74.       procedure StoreStruct (var S : TStream);  VIRTUAL;
  75.       procedure DoneStruct;  VIRTUAL;
  76.       procedure DoneData;  VIRTUAL;
  77.       function  Valid (Command : word)  : boolean;  VIRTUAL;
  78.       procedure ChangeBounds (var Bounds : TRect);  VIRTUAL;
  79.       function  GetPalette  : PPalette;  VIRTUAL;
  80.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  81.       procedure WrongKeypressed (var Event : TEvent);  VIRTUAL;
  82.       procedure SetState (AState : word;  Enable : boolean);  VIRTUAL;
  83.       function  DataAt (RecNum : integer)  : pointer;  VIRTUAL;
  84.       procedure DrawRecord (Y : integer;  var DataRecord );
  85.       procedure Draw;  VIRTUAL;
  86.       private
  87.     InBuffer    : boolean;
  88.     DDelta,DSize    : TPoint;
  89.     vwidth        : integer;
  90.     end;
  91.  
  92.  
  93.     TDmxRecInd   =  OBJECT (TDmxLink)
  94.       constructor Init (Bounds : TRect;  Len : integer);
  95.       constructor InitInsert (AOwner : PGroup; Len : integer);
  96.       procedure SetState (AState : word; Enable : boolean);  VIRTUAL;
  97.       procedure Draw;  VIRTUAL;
  98.     end;
  99.  
  100.  
  101.     TDmxEditor   =  OBJECT (TDmxScroller)
  102.     RecInd        : PDmxLink;
  103.     FieldData    : pointer;
  104.     RecordData    : pointer;
  105.     CurPos        : integer;
  106.     Vidis        : boolean;
  107.     DoubleValid    : boolean;
  108.     FirstKey    : boolean;
  109.     RedrawRecord    : boolean;
  110.     FieldAltered    : boolean;
  111.     RecordAltered    : boolean;
  112.     JustAltered    : boolean;
  113.     DataAltered    : boolean;
  114.     FieldSelected    : boolean;
  115.     RecordSelected    : boolean;
  116.       constructor Init (ATemplate  : string;  var AData; BSize : longint;
  117.             var Bounds : TRect;  ALabels,ARecInd  : PDmxLink;
  118.             AHScrollBar,AVScrollBar : PScrollBar);
  119.       constructor Load (var S : TStream);
  120.       destructor  Done;  VIRTUAL;
  121.       procedure Store (var S : TStream);
  122.       procedure SetState (AState : word;  Enable : boolean);  VIRTUAL;
  123.       procedure ChangeBounds (var Bounds : TRect);  VIRTUAL;
  124.       procedure ChangeMade;
  125.       procedure SetUpField;  VIRTUAL;
  126.       procedure EvaluateField;  VIRTUAL;
  127.       procedure SetUpRecord;  VIRTUAL;
  128.       procedure EvaluateRecord;  VIRTUAL;
  129.       procedure Draw;  VIRTUAL;
  130.       procedure DrawField (var Field : pDMXfieldrec);
  131.       procedure ZeroizeRecord;  VIRTUAL;
  132.       procedure ZeroizeField (Whole : boolean; Field : pDMXfieldrec);  VIRTUAL;
  133.       procedure ProcessMouse   (var Event : TEvent);
  134.       procedure ProcessCommand (var Command : word;  XY  : TPoint);
  135.       procedure ProcessEnter (var Event : TEvent);  VIRTUAL;
  136.       procedure ProcessKey (var Event : TEvent);
  137.       procedure GotoPos (AFieldNum,ARecNum : integer);
  138.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  139.       private
  140.     FirstPos    : integer;
  141.     ShowFmt        : showset;
  142.     end;
  143.  
  144.  
  145. const
  146.     RDmxLabels   :  TStreamRec = (
  147.     ObjType:  cmDMX + 1;
  148.     VmtLink:  ofs (TypeOf (TDmxLabels)^);
  149.     Load:     @TDmxLabels.Load;
  150.     Store:    @TDmxLabels.Store
  151.       );
  152.  
  153.     RDmxScroller :  TStreamRec = (
  154.     ObjType:  cmDMX + 2;
  155.     VmtLink:  ofs (TypeOf (TDmxScroller)^);
  156.     Load:     @TDmxScroller.Load;
  157.     Store:    @TDmxScroller.Store
  158.       );
  159.  
  160.     RDmxRecInd   :  TStreamRec = (
  161.     ObjType:  cmDMX + 3;
  162.     VmtLink:  ofs (TypeOf (TDmxRecInd)^);
  163.     Load:     @TDmxRecInd.Load;
  164.     Store:    @TDmxRecInd.Store
  165.       );
  166.  
  167.     RDmxEditor   :  TStreamRec = (
  168.     ObjType:  cmDMX + 4;
  169.     VmtLink:  ofs (TypeOf (TDmxEditor)^);
  170.     Load:     @TDmxEditor.Load;
  171.     Store:    @TDmxEditor.Store
  172.       );
  173.  
  174.  
  175.   procedure RegisterDMX;
  176.  
  177.  
  178. implementation
  179.  
  180.  
  181.   { ══ TDmxLink ══════════════════════════════════════════════════════════ }
  182.  
  183.  
  184. constructor TDmxLink.Init (Bounds : TRect);
  185. begin
  186.   TView.Init (Bounds);
  187.   GrowMode  := gfGrowLoY or gfGrowHiY;
  188.   EventMask := evMessage;
  189. end;
  190.  
  191.  
  192. constructor TDmxLink.Load (var S : TStream);
  193. begin
  194.   TView.Load (S);
  195.   GetPeerViewPtr (S, Link);
  196. end;
  197.  
  198.  
  199. function  TDmxLink.GetPalette : PPalette;
  200. begin
  201.   GetPalette := @cDMX
  202. end;
  203.  
  204.  
  205. procedure TDmxLink.Store (var S : TStream);
  206. begin
  207.   TView.Store (S);
  208.   PutPeerViewPtr (S, Link);
  209. end;
  210.  
  211.  
  212. procedure TDmxLink.Insert (AOwner : PGroup);
  213. begin
  214.   If (AOwner <> nil) then AOwner^.Insert (@Self);
  215. end;
  216.  
  217.  
  218.   { ══ TDmxLabels ════════════════════════════════════════════════════════ }
  219.  
  220.  
  221. constructor TDmxLabels.Init (DataStr : pstring;  var Bounds : TRect);
  222. begin
  223.   TDmxLink.Init (Bounds);
  224.   Move (DataStr, Data, sizeof (Data));
  225.   Len := length (DataStr^);
  226.   Inc (PtrRec (Data).Ofs);
  227.   GrowMode := gfGrowHiX;
  228. end;
  229.  
  230.  
  231. constructor TDmxLabels.InitInsert (AOwner : PGroup;  DataStr : pstring);
  232. var  R : TRect;
  233. begin
  234.   AOwner^.GetExtent (R);
  235.   Inc (R.A.Y);
  236.   R.B.Y  := R.A.Y + 2;
  237.   R.Grow (-1, 0);
  238.   TDmxLink.Init (R);
  239.   Move (DataStr, Data, sizeof (Data));
  240.   Len := length (DataStr^);
  241.   Inc (PtrRec (Data).Ofs);
  242.   GrowMode := gfGrowHiX;
  243.   Insert (AOwner);
  244. end;
  245.  
  246.  
  247. procedure TDmxLabels.HandleEvent (var Event : TEvent);
  248. var  dX,dY  : integer;
  249. begin
  250.   TDmxLink.HandleEvent (Event);
  251.   With Event do
  252.     If (What = evBroadcast) and (Command = cmDMX_FixSize) and (Size.X > Len) then
  253.       begin
  254.       dX := (Owner^.Size.X - Size.X) + Len;
  255.       dY :=  Owner^.Size.Y;
  256.       Owner^.GrowTo (dX, dY);
  257.       end;
  258. end;
  259.  
  260.  
  261. procedure TDmxLabels.Draw;
  262. var  A  : string;
  263. begin
  264.   Move (Data^ [Link^.Delta.X], A [1], Size.X);
  265.   If (Link^.Delta.X + Size.X > Len) then
  266.     fillchar (A [succ (Len - Link^.Delta.X)], (Size.X + Link^.Delta.X - Len), ' ');
  267.   A [0] := chr (lo (Size.X));
  268.   WriteStr (0, 0, A, 1);
  269.   If (Size.Y > 1) then DrawRuler (TRUE, FALSE);
  270. end;
  271.  
  272.  
  273. procedure TDmxLabels.DrawRuler (Upper, AtLimit : boolean);
  274. const
  275.   LtArr        =  17;
  276.   RtArr        =  16;
  277.   Markers    : string [10] = '─═┬╤╥╦┴╧╨╩';
  278. var
  279.   Color        : word;
  280.   i,X,width    : integer;
  281.   Mk        : integer;
  282.   frontcut    : integer;
  283.   fieldrec    : pDMXfieldrec;
  284.   A        : string;
  285.   B        : TDrawBuffer;
  286. begin
  287.   If (longint (Size) = 0) or (Link = nil) or (Link^.DMXfield1 = nil) then Exit;
  288.   fieldrec  := Link^.LeftField;
  289.   If (fieldrec = nil) or (fieldrec^.screentab > Link^.Delta.X) then
  290.     fiel